############################################################################
# 
# Glob-like matcher
#
# Performs matching of a string to pattern with * placeholders.
# Matches are _minimal_ substrings that fits into pattern.
#
# Examples:
#   match a*c abc -> abc b
#   match a*c zzzabbbcddd -> abbbc bbb
#   match a*b*c abaaaabc -> abaaaabc {} aaaab
#   match a* abc -> a {}
#   match a*b zzz ->
#
# Copyright (c) 2013, Alexander Galanin <al@galanin.nnov.ru>
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# 
# * Redistributions of source code must retain the above copyright notice,
#   this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright
#   notice, this list of conditions and the following disclaimer in the
#   documentation and/or other materials provided with the distribution.
# * Neither the name of Alexander Galanin nor the names of its contributors
#   may be used to endorse or promote products derived from this software
#   without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL Alexander Galanin BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
############################################################################

package require Tcl 8.5
package require cmdline

package provide glob_matcher 1.0

namespace eval glob_matcher {

namespace export match

# Match a pattern against to a string
# @param options if -all is given, proc will act like [regexp -all -inline] and
# return list of all matches; if -command 'cmd' given, all results of command
# invocation will be passed to specified command
# @param expression expression with *-placeholders
# @param string string to match
# @return if -command is given, return matches count, otherwise return matched
# substring, match1, match2... matchN
proc match {args} {
    set all false
    set command {}
    while {[set res [cmdline::getopt args {all command.arg} opt value]] == 1} {
        set $opt $value
    }
    if {$res == -1 || [llength $args] != 2} {
        error "usage: match ?-all|-command cmd? expression string"
    }
    lassign $args expression string
    set idx 0
    if {$command ne ""} {
        set res 0
    } else {
        set res {}
    }
    while {[llength [set cur [matchOnce $expression $string idx]]] > 0} {
        if {$command ne ""} {
            incr res
            uplevel #0 [concat $command $cur]
        } else {
            set res [concat $res $cur]
        }
        if {!$all} {
            break
        }
    }
    return $res
}

# Match a pattern against to a string one time
# @param expression expression with *-placeholders
# @param string string to match
# @param indexVar variable that contain start index for matching and will be
# updated to end index on finish
# @return list: matched substring, match1, match2... matchN
proc matchOnce {expression string indexVar} {
    upvar $indexVar idx
    set first end
    set res {}
    set hasIncomplete false
    foreach substr [split $expression "*"] {
        set pos [string first $substr $string $idx]
        if {$pos < 0} {
            # no matches
            return {}
        }
        if {$first eq "end"} {
            set first $pos
        }
        if {$hasIncomplete} {
            lappend res [string range $string $idx $pos-1]
        }
        set idx [expr {$pos + [string length $substr]}]
        set hasIncomplete true
    }
    concat [list [string range $string $first $idx-1]] $res
}

}
